home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / embed.pl < prev    next >
Perl Script  |  1998-07-22  |  6KB  |  324 lines
  1. #!/usr/bin/perl -w
  2.  
  3. require 5.003;
  4.  
  5. # XXX others that may need adding
  6. #       warnhook
  7. #       hints
  8. #       copline
  9. my @extvars = qw(sv_undef sv_yes sv_no na dowarn
  10.                  curcop compiling 
  11.                  tainting tainted stack_base stack_sp sv_arenaroot
  12.                  curstash DBsub DBsingle debstash
  13.                  rsfp 
  14.                  stdingv
  15.          defgv
  16.          errgv
  17.          rsfp_filters
  18.          perldb
  19.          diehook
  20.          dirty
  21.          perl_destruct_level
  22.                 );
  23.  
  24. sub readsyms (\%$) {
  25.     my ($syms, $file) = @_;
  26.     %$syms = ();
  27.     local (*FILE, $_);
  28.     open(FILE, "< $file")
  29.     or die "embed.pl: Can't open $file: $!\n";
  30.     while (<FILE>) {
  31.     s/[ \t]*#.*//;        # Delete comments.
  32.     if (/^\s*(\S+)\s*$/) {
  33.         $$syms{$1} = 1;
  34.     }
  35.     }
  36.     close(FILE);
  37. }
  38.  
  39. readsyms %global, 'global.sym';
  40. readsyms %interp, 'interp.sym';
  41.  
  42. sub readvars(\%$$) {
  43.     my ($syms, $file,$pre) = @_;
  44.     %$syms = ();
  45.     local (*FILE, $_);
  46.     open(FILE, "< $file")
  47.     or die "embed.pl: Can't open $file: $!\n";
  48.     while (<FILE>) {
  49.     s/[ \t]*#.*//;        # Delete comments.
  50.     if (/PERLVARI?C?\($pre(\w+)/) {
  51.         $$syms{$1} = 1;
  52.     }
  53.     }
  54.     close(FILE);
  55. }
  56.  
  57. my %intrp;
  58. my %thread;
  59.  
  60. readvars %intrp,  'intrpvar.h','I';
  61. readvars %thread, 'thrdvar.h','T';
  62. readvars %globvar, 'perlvars.h','G';
  63.  
  64. foreach my $sym (sort keys %intrp)
  65.  {
  66.   warn "$sym not in interp.sym\n" unless exists $interp{$sym};
  67.   if (exists $global{$sym})
  68.    {
  69.     delete $global{$sym};
  70.     warn "$sym in global.sym as well as interp\n";
  71.    }
  72.  }
  73.  
  74. foreach my $sym (sort keys %globvar)
  75.  {
  76.   if (exists $global{$sym})
  77.    {
  78.     delete $global{$sym};
  79.     warn "$sym in global.sym as well as perlvars.h\n";
  80.    }
  81.  }
  82.  
  83. foreach my $sym (keys %interp)
  84.  {
  85.   warn "extra $sym in interp.sym\n" 
  86.    unless exists $intrp{$sym} || exists $thread{$sym};
  87.  }
  88.  
  89. foreach my $sym (sort keys %thread)
  90.  {
  91.   warn "$sym in intrpvar.h\n" if exists $intrp{$sym};
  92.   if (exists $global{$sym})
  93.    {
  94.     delete $global{$sym};
  95.     warn "$sym in global.sym as well as thread\n";
  96.    }
  97.  }
  98.  
  99. sub hide ($$) {
  100.     my ($from, $to) = @_;
  101.     my $t = int(length($from) / 8);
  102.     "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
  103. }
  104. sub embed ($) {
  105.     my ($sym) = @_;
  106.     hide($sym, "Perl_$sym");
  107. }
  108. sub embedvar ($) {
  109.     my ($sym) = @_;
  110. #   hide($sym, "Perl_$sym");
  111.     return '';
  112. }
  113.  
  114. sub multon ($$$) {
  115.     my ($sym,$pre,$ptr) = @_;
  116.     hide("PL_$sym", "($ptr$pre$sym)");
  117. }
  118. sub multoff ($$) {
  119.     my ($sym,$pre) = @_;
  120.     return hide("PL_$pre$sym", "PL_$sym");
  121. }
  122.  
  123. unlink 'embed.h';
  124. open(EM, '> embed.h')
  125.     or die "Can't create embed.h: $!\n";
  126.  
  127. print EM <<'END';
  128. /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
  129.    This file is built by embed.pl from global.sym, intrpvar.h,
  130.    and thrdvar.h.  Any changes made here will be lost!
  131. */
  132.  
  133. /* (Doing namespace management portably in C is really gross.) */
  134.  
  135. /*  EMBED has no run-time penalty, but helps keep the Perl namespace
  136.     from colliding with that used by other libraries pulled in
  137.     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
  138.     override, however, to keep binary compatability with previous
  139.     versions of perl.
  140. */
  141. #ifndef NO_EMBED
  142. #  define EMBED 1 
  143. #endif
  144.  
  145. /* Hide global symbols? */
  146.  
  147. #ifdef EMBED
  148.  
  149. END
  150.  
  151. for $sym (sort keys %global) {
  152.     print EM embed($sym);
  153. }
  154.  
  155. print EM <<'END';
  156.  
  157. #endif /* EMBED */
  158.  
  159. END
  160.  
  161. close(EM);
  162.  
  163. unlink 'embedvar.h';
  164. open(EM, '> embedvar.h')
  165.     or die "Can't create embedvar.h: $!\n";
  166.  
  167. print EM <<'END';
  168. /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
  169.    This file is built by embed.pl from global.sym, intrpvar.h,
  170.    and thrdvar.h.  Any changes made here will be lost!
  171. */
  172.  
  173. /* (Doing namespace management portably in C is really gross.) */
  174.  
  175. /*  EMBED has no run-time penalty, but helps keep the Perl namespace
  176.     from colliding with that used by other libraries pulled in
  177.     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
  178.     override, however, to keep binary compatability with previous
  179.     versions of perl.
  180. */
  181.  
  182.  
  183. /* Put interpreter-specific symbols into a struct? */
  184.  
  185. #ifdef MULTIPLICITY
  186.  
  187. #ifndef USE_THREADS
  188. /* If we do not have threads then per-thread vars are per-interpreter */
  189.  
  190. END
  191.  
  192. for $sym (sort keys %thread) {
  193.     print EM multon($sym,'T','PL_curinterp->');
  194. }
  195.  
  196. print EM <<'END';
  197.  
  198. #endif /* !USE_THREADS */
  199.  
  200. /* These are always per-interpreter if there is more than one */
  201.  
  202. END
  203.  
  204. for $sym (sort keys %intrp) {
  205.     print EM multon($sym,'I','PL_curinterp->');
  206. }
  207.  
  208. print EM <<'END';
  209.  
  210. #else    /* !MULTIPLICITY */
  211.  
  212. END
  213.  
  214. for $sym (sort keys %intrp) {
  215.     print EM multoff($sym,'I');
  216. }
  217.  
  218. print EM <<'END';
  219.  
  220. #ifndef USE_THREADS
  221.  
  222. END
  223.  
  224. for $sym (sort keys %thread) {
  225.     print EM multoff($sym,'T');
  226. }
  227.  
  228. print EM <<'END';
  229.  
  230. #endif /* USE_THREADS */
  231.  
  232. /* Hide what would have been interpreter-specific symbols? */
  233.  
  234. #ifdef EMBED
  235.  
  236. END
  237.  
  238. for $sym (sort keys %intrp) {
  239.     print EM embedvar($sym);
  240. }
  241.  
  242. print EM <<'END';
  243.  
  244. #ifndef USE_THREADS
  245.  
  246. END
  247.  
  248. for $sym (sort keys %thread) {
  249.     print EM embedvar($sym);
  250. }
  251.  
  252. print EM <<'END';
  253.  
  254. #endif /* USE_THREADS */
  255. #endif /* EMBED */
  256. #endif /* MULTIPLICITY */
  257.  
  258. /* Now same trickey for per-thread variables */
  259.  
  260. #ifdef USE_THREADS
  261.  
  262. END
  263.  
  264. for $sym (sort keys %thread) {
  265.     print EM multon($sym,'T','thr->');
  266. }
  267.  
  268. print EM <<'END';
  269.  
  270. #endif /* USE_THREADS */
  271.  
  272. #ifdef PERL_GLOBAL_STRUCT
  273.  
  274. END
  275.  
  276. for $sym (sort keys %globvar) {
  277.     print EM multon($sym,'G','PL_Vars.');
  278. }
  279.  
  280. print EM <<'END';
  281.  
  282. #else /* !PERL_GLOBAL_STRUCT */
  283.  
  284. END
  285.  
  286. for $sym (sort keys %globvar) {
  287.     print EM multoff($sym,'G');
  288. }
  289.  
  290. print EM <<'END';
  291.  
  292. #ifdef EMBED
  293.  
  294. END
  295.  
  296. for $sym (sort keys %globvar) {
  297.     print EM embedvar($sym);
  298. }
  299.  
  300. print EM <<'END';
  301.  
  302. #endif /* EMBED */
  303. #endif /* PERL_GLOBAL_STRUCT */
  304.  
  305. END
  306.  
  307. print EM <<'END';
  308.  
  309. #ifndef MIN_PERL_DEFINE  
  310.  
  311. END
  312.  
  313. for $sym (sort @extvars) {
  314.     print EM hide($sym,"PL_$sym");
  315. }
  316.  
  317. print EM <<'END';
  318.  
  319. #endif /* MIN_PERL_DEFINE */
  320. END
  321.  
  322.  
  323. close(EM);
  324.